Reconhecimento da base



Verificação das amostras e variáveis

## 'data.frame':    6497 obs. of  13 variables:
##  $ fixedacidity      : num  6.6 6.7 10.6 5.4 6.7 6.8 6.6 7.2 5.1 6.2 ...
##  $ volatileacidity   : num  0.24 0.34 0.31 0.18 0.3 0.5 0.61 0.66 0.26 0.22 ...
##  $ citricacid        : num  0.35 0.43 0.49 0.24 0.44 0.11 0 0.33 0.33 0.2 ...
##  $ residualsugar     : num  7.7 1.6 2.2 4.8 18.8 ...
##  $ chlorides         : num  0.031 0.041 0.063 0.041 0.057 0.075 0.069 0.068 0.027 0.035 ...
##  $ freesulfurdioxide : num  36 29 18 30 65 16 4 34 46 58 ...
##  $ totalsulfurdioxide: num  135 114 40 113 224 49 8 102 113 184 ...
##  $ density           : num  0.994 0.99 0.998 0.994 1 ...
##  $ pH                : num  3.19 3.23 3.14 3.42 3.11 3.36 3.33 3.27 3.35 3.11 ...
##  $ sulphates         : num  0.37 0.44 0.51 0.4 0.53 0.79 0.37 0.78 0.43 0.53 ...
##  $ alcohol           : num  10.5 12.6 9.8 9.4 9.1 9.5 10.4 12.8 11.4 9 ...
##  $ quality           : int  5 6 6 6 5 5 4 6 7 6 ...
##  $ Vinho             : Factor w/ 2 levels "RED","WHITE": 2 2 1 2 2 1 1 1 2 2 ...

A base possui 6497 amostras com as seguintes variáveis:

  1. Fixed Acidity: Acidez contida no vinho

  2. Volatile Acidity: Quantidade de ácido acético no vinho, valores altos podem levar o vinho a ter sabor desagradável de vinagre

  3. Citric Acid: Encontrado em pouca quantidade, o ácido cítrico pode adicionar frescor e sabor ao vinho.

  4. Residual Sugar: Quantidade de açucar restante após o término da fermentação. É raro encontrar vinhos com menos de 1 g/l e vinhos com valores maiores que 45 g/l são considerardos doces.

  5. Chlorides: Quantidade de sal no vinho

  6. Free Sulfur Dioxide: A forma livre de SO2 (dióxido de enxofre) existe em equilibrio entre SO2 molecular (como um gás dissolvido) e ions bissulfito. Evita o crescimento de micróbios e oxidação do vinho.

  7. Total Sulfur Dioxide: Total de SO2 livres ou ligados. Em baixa concentração, o SO2 é praticamente imperceptível no vinho, mas em concentrações acima de 50 ppm, o dióxido de enxofre torna-se evidente no aroma e sabor do vinho

  8. Density: A densidade do vinho depende do percentual de álcool e açúcar.

  9. pH: Descreve se o vinho é básico (14) ou ácido (0). A maioria dos vinhos possuem pH entre 3 e 4

  10. Sulphates: Aditivo que pode contribuir com os níveis de SO2, que age contra micróbios e oxidação

  11. Alcohol: O percentual de álcool no vinho

  12. Quality: Qualidade do vinho com pontuação de 0 a 10, sendo 10 muito bom e 0 de péssima qualidade

  13. Vinho: Tipo do vinho: tinto (RED) ou branco (WHITE)



Sumário dos dados

##   fixedacidity    volatileacidity    citricacid     residualsugar  
##  Min.   : 3.800   Min.   :0.0800   Min.   :0.0000   Min.   : 0.60  
##  1st Qu.: 6.400   1st Qu.:0.2300   1st Qu.:0.2500   1st Qu.: 1.80  
##  Median : 7.000   Median :0.2900   Median :0.3100   Median : 3.00  
##  Mean   : 7.215   Mean   :0.3397   Mean   :0.3186   Mean   : 5.44  
##  3rd Qu.: 7.700   3rd Qu.:0.4000   3rd Qu.:0.3900   3rd Qu.: 8.10  
##  Max.   :15.900   Max.   :1.5800   Max.   :1.6600   Max.   :45.80  
##    chlorides       freesulfurdioxide totalsulfurdioxide    density      
##  Min.   :0.00900   Min.   :  1.00    Min.   :  6.0      Min.   :0.9871  
##  1st Qu.:0.03800   1st Qu.: 17.00    1st Qu.: 77.0      1st Qu.:0.9923  
##  Median :0.04700   Median : 29.00    Median :118.0      Median :0.9949  
##  Mean   :0.05603   Mean   : 30.53    Mean   :115.7      Mean   :0.9947  
##  3rd Qu.:0.06500   3rd Qu.: 41.00    3rd Qu.:156.0      3rd Qu.:0.9970  
##  Max.   :0.61100   Max.   :289.00    Max.   :440.0      Max.   :1.0140  
##        pH          sulphates         alcohol           quality     
##  Min.   :2.720   Min.   :0.2200   Min.   : 0.9567   Min.   :3.000  
##  1st Qu.:3.110   1st Qu.:0.4300   1st Qu.: 9.5000   1st Qu.:5.000  
##  Median :3.210   Median :0.5100   Median :10.3000   Median :6.000  
##  Mean   :3.219   Mean   :0.5313   Mean   :10.4862   Mean   :5.818  
##  3rd Qu.:3.320   3rd Qu.:0.6000   3rd Qu.:11.3000   3rd Qu.:6.000  
##  Max.   :4.010   Max.   :2.0000   Max.   :14.9000   Max.   :9.000  
##    Vinho     
##  RED  :1599  
##  WHITE:4898  
##              
##              
##              
## 

Analisando o sumário, nota-se potenciais outliers dados que os valores mínimos e máximos estão muito distantes dos quartis para as seguintes variáveis: fixedacidity, volatileacidity, citricacid, residualsugar, chlorides, freesulfurdioxide, totalsulfurdioxide, sulphates e alcohol

Além disso, há valores muito discrepantes:

  • Citric Acid com valor mínimo 0

  • Total Sulfur Dioxide com valor mínimo 6

  • Alcohol com valor mínimo 0,9667



Frequencia Absoluta

##    
##      RED WHITE
##   3   10    20
##   4   53   163
##   5  681  1457
##   6  638  2198
##   7  199   880
##   8   18   175
##   9    0     5

Analisando a quantidade de vinhos por tipo e por qualidade, há mais vinhos do tipo branco do que tinto no data set. Também nota-se que ambos vinhos seguem uma tendência normal com relação à qualidade.



Valores estatisticos relevantes para o vinho tinto

Valores estatisticos relevantes para o vinho branco

Razão entre as estatísticas do vinho tinto para o vinho branco

Comparando-se os atributos dos vinhos tintos com os vinhos brancos de forma tabular através da observação dos parâmetros de máximo, mínimo, média, desvio padrão e mediana da amostra. Temos:

  • Quase todos os atributos dos vinhos tem distribuição bem diferentes.
  • Alguns poucos são semelhantes, pode-se citar: density, pH e quality
  • Outros são muito desiguais: residualsugar,freesulfurdioxide,totalsulfurdioxide
  • Para as outras características há diferenças significativas nos parâmetros entre 20% a quase 500%

Antes de qualquer conclusão, deve-se tratar as questões do outliers e valores faltantes que podem estar influenciando esta amostra.



Análise do açucar residual nos vinhos

## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## | Chi-square contribution |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  6497 
## 
##  
##                    | Vinhos$Vinho 
## Vinhos$fx_redSugar |       RED |     WHITE | Row Total | 
## -------------------|-----------|-----------|-----------|
##             (0,10] |      1588 |      3705 |      5293 | 
##                    |    62.493 |    20.401 |           | 
##                    |     0.300 |     0.700 |     0.815 | 
##                    |     0.993 |     0.756 |           | 
##                    |     0.244 |     0.570 |           | 
## -------------------|-----------|-----------|-----------|
##            (10,20] |        11 |      1175 |      1186 | 
##                    |   270.305 |    88.244 |           | 
##                    |     0.009 |     0.991 |     0.183 | 
##                    |     0.007 |     0.240 |           | 
##                    |     0.002 |     0.181 |           | 
## -------------------|-----------|-----------|-----------|
##            (20,30] |         0 |        15 |        15 | 
##                    |     3.692 |     1.205 |           | 
##                    |     0.000 |     1.000 |     0.002 | 
##                    |     0.000 |     0.003 |           | 
##                    |     0.000 |     0.002 |           | 
## -------------------|-----------|-----------|-----------|
##          (30,45.8] |         0 |         3 |         3 | 
##                    |     0.738 |     0.241 |           | 
##                    |     0.000 |     1.000 |     0.000 | 
##                    |     0.000 |     0.001 |           | 
##                    |     0.000 |     0.000 |           | 
## -------------------|-----------|-----------|-----------|
##       Column Total |      1599 |      4898 |      6497 | 
##                    |     0.246 |     0.754 |           | 
## -------------------|-----------|-----------|-----------|
## 
## 

Através da análise acima, pode-se verificar que que a quantidade de açúcar restante nos vinhos tintos é muito menor, sendo que 99,3% destes vinhos tem até 10 g/l e apenas 0,7% possuem quantidade até 20g/l. No caso dos vinhos brancos, percebe-se 75,6% possuem até 10g/l de quantidade de açúcar restante, 24% até 20g/l, 0,3% até 30g/l e 0,1% até 45.8g/l

Por esta tabela, pode-se deduzir que os vinhos brancos são normalmente percebidos como mais doces que os vinhos tintos.





Análise Exploratória dos Dados



Retmoção de valores nulos ou zerados

Pelos resultados observados de forma tabular, temos que apenas o atributo citricacid possui valores zerados.

Abaixo são listados as amostras com ácido cítrico zerado:

##   [1]    7   17   29   32   35   55   74  155  182  189  235  284  295  308
##  [15]  328  336  436  470  618  628  824  882  884  918  979 1012 1061 1079
##  [29] 1141 1187 1212 1222 1237 1244 1425 1608 1699 1700 1757 1812 1834 1836
##  [43] 1850 1875 1895 1898 1906 1956 2239 2315 2402 2442 2451 2471 2489 2566
##  [57] 2578 2652 2668 2724 2843 2878 2902 2906 2921 2966 3002 3078 3117 3220
##  [71] 3261 3262 3300 3322 3441 3456 3469 3481 3507 3508 3596 3744 3799 3847
##  [85] 3940 3973 3980 4036 4071 4129 4152 4200 4208 4216 4272 4282 4289 4321
##  [99] 4394 4397 4512 4517 4534 4547 4549 4604 4704 4712 4768 4769 4814 4864
## [113] 4884 4947 4980 5048 5063 5079 5088 5108 5198 5301 5368 5389 5395 5406
## [127] 5432 5468 5497 5518 5538 5552 5594 5634 5651 5752 5778 5800 5813 5861
## [141] 5881 6013 6029 6077 6109 6256 6309 6394 6436 6451 6458

Conforme pesquisado na Internet (https://vinosdiferentes.com/pt/acidez-do-vinho/) , sabemos que o valor do ácido cítrico deve variar entre 0.1 e 1. Deste modo, muito provavelmente, o valor zerado deve ocorrer por imprecisão dos aparelhos de medição da concentração de ácido cítrico. Fazemos a sua substituição pelo valor mínimo (0.1)

#Segundo o site https://vinosdiferentes.com/pt/acidez-do-vinho/
#O valor do ácido cítrico é bem baixo, entre 0,1 e 1 g / litro 
#Esse valor zerado pode ter sido a imprecisão dos aparelhos de medição
#Vamos trocá-los por 0.1 que é o valor mais provável 
Vinhos[vinhosComZero,"citricacid"] <- 0.1



Quanto a existência de valores inválidos ou não inexistentes, isto não foi detectado na amostra.

#Verifica se há valores faltantes no dataset 
nVinhosComValoresFaltantes <- length(Vinhos[is.na(Vinhos)]) + length(Vinhos[is.nan(as.matrix(Vinhos))])
paste0("Vinhos com valores faltantes = ",nVinhosComValoresFaltantes)
## [1] "Vinhos com valores faltantes = 0"



Boxplot das variáveis para visualização de outliers

Quando realizamos a quebra pelo tipo de vinho em boxplotes, percebemos as seguintes características:

  • fixedacidity - O vinho tinto possui potenciais outliers apenas acima da barreira enquanto o branco possui acima e abaixo das barreiras

  • citricacid - Há mais potenciais outliers para vinho branco e eles aparecem tanto acima como abaixo das barreiras

  • residual sugar - Para vinho tinto há mais potenciais outliers. Para vinho branco há menos, mas ficam mais distantes da barreira superior

  • freesulfurdioxide - Há mais potenciais outliers para o vinho branco e se localizam mais distantes da barreira superior.

  • totalsufurdioxide - Há potenciais outliers tanto abaixo como acima das barreira para vinhos brancos, para tinto apenas acima e mais próximos

  • density - Para tinto há um número maior de potenciais outliers, tanto abaixo como acima das barreiras, para branco há poucos e alguns bem distantes

  • sulphates - Para tinto há mais potenciais outliers e mais distantes da barreira superior

  • alcohol - Há potenciais outliers acima e abaixo das barreiras apenas para vinhos tintos.



Histograma dos atributos por tipo de vinho

Dividiu-se a amostra entre Vinhos Tintos e Vinhos Brancos

A partir dessa divisão, traçaram-se lado a lado os histogramas dessa subdivisão e percebe-se que o histograma é bem diferente para cada atributo e cada tipo de vinho (tinto e branco)

A percepção visual será complementada com os testes T das médias dos atributos numéricos para a comprovação das diferenças.



Teste de hipótese para cada atributo entre os dois tipos de vinho

## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo fixedacidity"
## 
##  Welch Two Sample t-test
## 
## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 32.423, df = 1848.9, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  1.376241 1.553458
## sample estimates:
## mean of x mean of y 
##  8.319637  6.854788 
## 
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo volatileacidity"
## 
##  Welch Two Sample t-test
## 
## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 53.059, df = 1938.9, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.2403544 0.2588044
## sample estimates:
## mean of x mean of y 
## 0.5278205 0.2782411 
## 
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo citricacid"
## 
##  Welch Two Sample t-test
## 
## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -11.216, df = 2055.3, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.06502621 -0.04567110
## sample estimates:
## mean of x mean of y 
## 0.2792308 0.3345794 
## 
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo residualsugar"
## 
##  Welch Two Sample t-test
## 
## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -48.057, df = 6401, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -4.005513 -3.691539
## sample estimates:
## mean of x mean of y 
##  2.538806  6.387332 
## 
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo chlorides"
## 
##  Welch Two Sample t-test
## 
## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 34.24, df = 1827.8, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.03930596 0.04408241
## sample estimates:
##  mean of x  mean of y 
## 0.08746654 0.04577236 
## 
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo freesulfurdioxide"
## 
##  Welch Two Sample t-test
## 
## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -54.428, df = 4461.9, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -20.13315 -18.73318
## sample estimates:
## mean of x mean of y 
##  15.87492  35.30808 
## 
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo totalsulfurdioxide"
## 
##  Welch Two Sample t-test
## 
## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -89.872, df = 3477, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -93.89760 -89.88813
## sample estimates:
## mean of x mean of y 
##  46.46779 138.36066 
## 
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo density"
## 
##  Welch Two Sample t-test
## 
## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 43.15, df = 4252.3, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.002600624 0.002848190
## sample estimates:
## mean of x mean of y 
## 0.9967467 0.9940223 
## 
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo pH"
## 
##  Welch Two Sample t-test
## 
## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 27.775, df = 2667.1, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.1141740 0.1315191
## sample estimates:
## mean of x mean of y 
##  3.311113  3.188267 
## 
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo sulphates"
## 
##  Welch Two Sample t-test
## 
## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 37.056, df = 2091, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.159395 0.177209
## sample estimates:
## mean of x mean of y 
## 0.6581488 0.4898469 
## 
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo alcohol"
## 
##  Welch Two Sample t-test
## 
## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -3.3571, df = 2852.3, p-value = 0.0007979
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.18088842 -0.04749554
## sample estimates:
## mean of x mean of y 
##  10.40008  10.51427 
## 
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo quality"
## 
##  Welch Two Sample t-test
## 
## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -10.149, df = 2950.8, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.2886173 -0.1951564
## sample estimates:
## mean of x mean of y 
##  5.636023  5.877909

Realizados os testes T para as amostras separadas de vinhos tintos e brancos, observam-se os fatos descritos abaixo: * Para cada atributo numérico dos vinhos brancos e tintos realizou-se um teste T * Os testes foram parametrizados com um nível de confiança de 95% * O p-value de cada um dos testes apresentou valores substancialmente menores que 5%.

Deste modo, para o modelo preditivo a ser desenvolvido, a partir deste ponto, iremos separar a amostras entre os dois tipos de vinho (tinto,branco) e prosseguiremos na criação do modelo preditivo da qualidade apenas para os vinhos brancos

Tratatamento dos outliers

## [1] "Potenciais outliers referentes ao atributo fixedacidity"
## [1] "Quantidade de potenciais outliers 119"
## [1] ""
##   [1]  9.3  9.1  9.2  9.2  9.2  9.3  9.2  9.8  8.9  9.2  9.2  4.2  9.8 10.3
##  [15] 10.2  9.8  9.0 10.0  8.9  8.9  9.2  9.0 10.0  9.0  9.2  9.8  9.0  4.7
##  [29]  8.9  4.7 10.7  8.9  9.6  9.2  8.9  8.9  9.0  9.1  9.8  9.2  9.4  9.0
##  [43]  9.6  9.0  9.2  9.6  9.3  9.8  9.2  9.0  9.9  4.7  4.4  9.6  8.9  9.8
##  [57]  9.9  8.9  9.4  9.2  8.9 10.0  9.0  4.6  9.0  3.8  9.0  9.2  9.0  9.7
##  [71]  9.2  9.7 11.8  9.7 14.2  8.9  8.9  9.7  4.7  9.4  9.5  9.4  9.1  9.4
##  [85]  9.0  9.0  9.4  9.6  9.0  9.2 10.7  9.8  9.1 10.3  3.9  9.2  4.4  8.9
##  [99]  9.4  9.0  9.2  4.4  8.9  4.2  9.5  9.0  9.4  4.7  9.2  9.2  9.1  9.4
## [113]  9.4  4.5  8.9  8.9  9.1  9.2  9.4
## [1] ""
## [1] "Potenciais outliers referentes ao atributo volatileacidity"
## [1] "Quantidade de potenciais outliers 186"
## [1] ""
##   [1] 0.580 0.560 0.510 0.520 0.695 0.670 0.550 0.610 0.640 0.710 0.640
##  [12] 0.555 0.540 0.570 0.510 0.520 0.660 0.610 0.595 0.520 0.620 0.580
##  [23] 0.490 0.530 0.550 0.520 0.590 0.570 0.510 0.490 0.550 0.560 0.540
##  [34] 0.590 0.910 0.660 0.510 0.550 0.640 0.690 0.670 0.510 0.490 0.540
##  [45] 0.690 0.580 0.555 0.580 0.600 0.545 0.500 0.610 0.670 0.815 0.650
##  [56] 0.530 0.540 0.655 0.600 0.520 0.550 0.560 0.670 0.655 0.500 0.520
##  [67] 0.680 0.615 0.490 0.560 0.550 0.490 0.930 0.490 0.685 0.520 0.530
##  [78] 0.550 0.760 0.640 0.490 0.560 0.600 0.510 0.580 0.640 0.620 1.005
##  [89] 0.560 0.965 0.520 0.500 0.520 0.490 0.560 0.540 0.500 0.530 0.520
## [100] 0.640 0.640 0.600 0.530 0.490 0.530 0.695 0.560 0.610 0.500 0.500
## [111] 0.730 0.500 0.510 0.660 0.600 0.670 0.580 0.780 0.680 0.630 0.615
## [122] 0.530 0.615 0.620 0.500 0.570 0.540 0.490 0.550 0.550 0.500 0.530
## [133] 0.550 0.785 0.570 1.100 0.705 0.600 0.850 0.510 0.500 0.600 0.495
## [144] 0.620 0.660 0.750 0.540 0.905 0.490 0.550 0.510 0.655 0.585 0.705
## [155] 0.680 0.580 0.500 0.540 0.595 0.610 0.540 0.500 0.650 0.610 0.615
## [166] 0.740 0.610 0.495 0.550 0.585 0.590 0.760 0.490 0.510 0.695 0.500
## [177] 0.620 0.540 0.550 0.490 0.630 0.590 0.550 0.490 0.560 0.500
## [1] ""
## [1] "Potenciais outliers referentes ao atributo citricacid"
## [1] "Quantidade de potenciais outliers 251"
## [1] ""
##   [1] 0.07 1.00 0.74 0.07 0.09 0.62 0.04 0.07 0.06 0.68 0.59 0.04 0.01 0.07
##  [15] 0.71 0.74 0.67 0.02 0.04 0.74 1.00 0.61 0.59 0.64 0.74 0.70 0.58 0.62
##  [29] 0.66 0.71 0.88 0.68 0.74 0.04 0.64 0.65 0.01 0.67 0.58 0.62 0.62 0.67
##  [43] 0.58 0.72 0.91 0.62 0.71 0.05 0.74 0.58 0.74 0.07 0.05 0.74 0.58 0.72
##  [57] 0.65 0.01 0.09 0.09 0.06 0.74 0.72 0.79 0.09 0.08 0.72 0.65 0.81 0.66
##  [71] 0.66 0.04 0.74 0.65 0.58 0.05 0.61 0.71 0.58 0.71 0.71 0.09 0.73 0.58
##  [85] 0.59 0.74 0.74 0.02 0.82 0.66 0.99 0.74 0.73 0.66 1.66 0.58 0.64 0.74
##  [99] 0.79 0.58 0.74 0.71 0.04 0.07 1.00 0.01 0.58 0.74 0.65 0.69 0.01 0.64
## [113] 0.67 0.73 0.09 0.60 0.74 0.74 0.74 0.80 0.60 0.60 0.69 0.06 0.01 1.23
## [127] 0.74 0.63 0.82 0.78 0.69 0.58 0.74 0.58 0.78 0.60 0.04 0.61 0.73 0.74
## [141] 0.65 0.74 0.66 0.65 1.00 0.74 0.61 0.02 0.62 0.61 0.08 0.06 0.68 0.02
## [155] 0.07 0.07 0.06 0.62 0.62 0.74 0.69 0.07 0.91 0.02 1.00 0.04 0.70 0.74
## [169] 0.59 0.68 0.09 0.74 0.74 0.05 0.61 0.08 0.68 0.02 0.71 0.61 0.62 0.07
## [183] 0.67 0.63 0.68 0.62 0.74 0.68 0.58 0.07 0.09 0.74 0.74 0.03 0.69 0.58
## [197] 0.60 0.65 0.74 0.81 0.80 0.67 0.58 0.08 0.74 0.62 0.09 0.09 0.04 0.72
## [211] 0.61 0.74 0.74 0.09 0.67 0.74 0.01 0.06 0.60 0.73 0.74 0.04 0.64 0.62
## [225] 0.63 0.58 0.63 0.04 0.58 0.64 0.74 0.07 0.74 0.59 0.61 0.58 0.74 0.03
## [239] 0.66 0.74 0.58 0.71 0.62 0.70 0.59 0.09 0.58 0.86 0.04 0.62 0.05
## [1] ""
## [1] "Potenciais outliers referentes ao atributo residualsugar"
## [1] "Quantidade de potenciais outliers 7"
## [1] ""
## [1] 26.05 31.60 22.60 45.80 31.60 26.05 23.50
## [1] ""
## [1] "Potenciais outliers referentes ao atributo chlorides"
## [1] "Quantidade de potenciais outliers 208"
## [1] ""
##   [1] 0.114 0.014 0.074 0.093 0.172 0.171 0.147 0.123 0.083 0.168 0.074
##  [12] 0.092 0.075 0.144 0.126 0.115 0.076 0.346 0.076 0.154 0.087 0.096
##  [23] 0.160 0.084 0.076 0.169 0.104 0.072 0.093 0.086 0.108 0.009 0.095
##  [34] 0.074 0.152 0.212 0.158 0.092 0.079 0.175 0.142 0.077 0.083 0.096
##  [45] 0.084 0.185 0.118 0.173 0.170 0.073 0.076 0.167 0.145 0.088 0.201
##  [56] 0.117 0.076 0.094 0.200 0.080 0.137 0.168 0.073 0.080 0.105 0.204
##  [67] 0.014 0.157 0.150 0.174 0.290 0.076 0.121 0.180 0.152 0.148 0.110
##  [78] 0.122 0.084 0.074 0.119 0.133 0.194 0.170 0.094 0.119 0.083 0.098
##  [89] 0.102 0.094 0.208 0.099 0.138 0.088 0.117 0.087 0.135 0.176 0.184
## [100] 0.185 0.078 0.142 0.120 0.211 0.157 0.092 0.082 0.086 0.080 0.149
## [111] 0.208 0.119 0.126 0.123 0.156 0.012 0.244 0.076 0.085 0.110 0.074
## [122] 0.239 0.138 0.098 0.110 0.142 0.076 0.072 0.083 0.096 0.121 0.014
## [133] 0.096 0.073 0.147 0.168 0.184 0.117 0.126 0.083 0.074 0.123 0.136
## [144] 0.085 0.137 0.197 0.074 0.075 0.082 0.074 0.094 0.096 0.081 0.108
## [155] 0.079 0.073 0.098 0.112 0.157 0.160 0.079 0.127 0.078 0.201 0.175
## [166] 0.169 0.084 0.123 0.087 0.271 0.089 0.255 0.097 0.096 0.176 0.081
## [177] 0.132 0.079 0.091 0.240 0.217 0.090 0.086 0.127 0.094 0.073 0.086
## [188] 0.076 0.173 0.167 0.179 0.301 0.090 0.209 0.013 0.014 0.197 0.130
## [199] 0.157 0.095 0.085 0.093 0.172 0.186 0.084 0.146 0.080 0.174
## [1] ""
## [1] "Potenciais outliers referentes ao atributo freesulfurdioxide"
## [1] "Quantidade de potenciais outliers 50"
## [1] ""
##  [1] 108.0  81.0  85.0 289.0 101.0 128.0  83.0  81.0  98.0  86.0  97.0
## [12]  96.0  86.0  87.0  96.0  87.0  82.5  81.0 122.5 146.5  88.0  82.0
## [23]  81.0 105.0  98.0  98.0  82.0 105.0  81.0 112.0 101.0  83.0  81.0
## [34] 131.0  83.0 108.0  85.0  87.0  95.0  93.0 124.0 138.5 108.0 110.0
## [45]  81.0 118.5  89.0  96.0  87.0  83.0
## [1] ""
## [1] "Potenciais outliers referentes ao atributo totalsulfurdioxide"
## [1] "Quantidade de potenciais outliers 19"
## [1] ""
##  [1] 440.0   9.0 256.0 260.0  19.0 294.0 307.5 256.0 272.0 259.0  18.0
## [12] 303.0  18.0 313.0 344.0  10.0 366.5 272.0 282.0
## [1] ""
## [1] "Potenciais outliers referentes ao atributo density"
## [1] "Quantidade de potenciais outliers 5"
## [1] ""
## [1] 1.00295 1.01030 1.01398 1.01030 1.00295
## [1] ""
## [1] "Potenciais outliers referentes ao atributo pH"
## [1] "Quantidade de potenciais outliers 75"
## [1] ""
##  [1] 3.80 3.59 3.57 3.60 3.64 3.63 3.58 2.79 3.82 2.79 3.68 3.65 3.65 3.66
## [15] 3.58 3.69 3.61 3.63 3.60 3.69 3.74 3.59 3.81 3.66 3.63 3.60 3.66 3.60
## [29] 3.57 3.72 2.80 2.77 3.64 3.57 3.63 3.65 3.63 3.59 3.59 3.66 3.68 2.72
## [43] 3.79 3.74 3.75 3.75 3.62 3.59 3.80 2.74 2.79 3.59 3.60 3.61 3.58 3.58
## [57] 3.60 3.57 3.77 3.57 3.58 3.72 3.76 3.65 3.72 3.76 3.60 3.66 3.70 3.61
## [71] 2.80 3.67 3.77 2.80 3.63
## [1] ""
## [1] "Potenciais outliers referentes ao atributo sulphates"
## [1] "Quantidade de potenciais outliers 124"
## [1] ""
##   [1] 0.77 0.78 0.78 0.98 0.78 0.79 0.79 0.79 0.86 0.79 0.77 0.82 0.95 0.80
##  [15] 0.77 0.79 0.78 0.90 0.88 0.79 0.78 0.78 0.81 0.78 0.78 0.82 0.97 0.78
##  [29] 0.78 0.77 0.83 0.81 0.80 0.77 0.88 0.78 0.90 0.79 1.00 0.96 0.82 0.84
##  [43] 0.81 0.88 0.82 0.80 0.77 0.98 0.84 0.78 0.79 0.77 0.82 0.88 0.77 0.82
##  [57] 0.82 0.98 0.94 0.87 0.82 0.78 0.81 0.79 0.78 0.92 0.82 0.94 0.88 0.88
##  [71] 0.79 0.96 0.96 0.77 1.06 0.83 0.85 1.08 0.81 0.95 0.98 0.78 0.79 0.84
##  [85] 0.98 0.92 0.80 0.78 0.79 0.90 0.77 0.79 0.86 0.79 0.77 0.82 0.95 0.85
##  [99] 0.79 0.77 0.99 0.77 0.95 0.77 0.82 0.77 0.77 0.78 0.89 0.82 0.78 0.80
## [113] 1.01 0.82 0.88 0.85 0.98 0.78 0.79 0.95 0.84 0.87 0.90 0.90
## [1] ""
## [1] "Potenciais outliers referentes ao atributo quality"
## [1] "Quantidade de potenciais outliers 200"
## [1] ""
##   [1] 8 8 8 8 8 9 8 8 8 8 8 8 8 3 8 8 8 8 8 8 8 8 3 8 8 8 8 8 8 8 3 8 8 8 8
##  [36] 8 3 3 8 8 3 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 9 8 8 8 8 8 8 8 8 8 8 8 8
##  [71] 8 8 3 8 9 8 8 8 9 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 3 3 8 8 3 8 8 8 8 8 3
## [106] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 3 8 8 3
## [141] 8 8 8 8 3 8 8 8 8 3 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 9
## [176] 8 3 8 8 8 8 8 8 8 8 8 8 3 3 8 8 8 3 8 8 8 8 3 8 8
## [1] ""

Há valores potenciais de outliers em quase todos os atributos dos vinhos brancos, exceto na concentração de alchool que não apresenta outliers

Para verificar se os valores são realmente outliers, sabendo-se que os vinhos são portugueses, utilizou-se os valores de referência do Instituto da Vinha e do Vinho de Portugal, com as informações presentes no link a seguir: http://www.ivv.gov.pt/np4/89/

  • Acidez Total >= 3.5 g/L
  • Acidez Volátil <= 500 mg/L
  • Ácido Cítrico <= 1 g/L
  • 1 g/L <= Açúcar Residual <= 32 g/L
  • Cloretos <= 1 g/L
  • Total Dióxiodo de Enxofre <= 250 mg/L



Extração dos outliers

## [1] "Sumário da qualidade dos vinhos Brancos considerados como outliers "
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   3.000   5.000   5.000   5.284   6.000   8.000

## [1] "Sumário da qualidade dos vinhos Brancos sem outliers"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    3.00    5.00    6.00    5.91    6.00    9.00
## [1] "Teste T para a média de qualidade entre os vinhos brancos sem outliers e a amostra completa"
## 
##  Welch Two Sample t-test
## 
## data:  VinhosBrancos$quality and VinhosBrancosSemOut$quality
## t = -1.7793, df = 9533.9, p-value = 0.07523
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.067137134  0.003248435
## sample estimates:
## mean of x mean of y 
##  5.877909  5.909854

Os vinhos brancos selecionados como outliers não possuíam uma distribuição especial em relação à qualidade e não afetavam a média da qualidade dos vinhos. Deste modo, realizou-se um teste T entre os vinhos brancos sem os outliers e a amostra completa, com 95% de confiança e falhou (p-value = 7,5%). Portanto as amostra possuem médias iguais. Por fim, os outliers foram retirados da amostra e do modelo a ser utilizado para predição.



Análise de Correlação das variáveis

##                    fixedacidity volatileacidity citricacid residualsugar
## fixedacidity             1.0000         -0.0351      0.282         0.079
## volatileacidity         -0.0351          1.0000     -0.089         0.072
## citricacid               0.2824         -0.0894      1.000         0.077
## residualsugar            0.0789          0.0724      0.077         1.000
## chlorides                0.0095          0.0461      0.128         0.076
## freesulfurdioxide       -0.0559         -0.0715      0.091         0.318
## totalsulfurdioxide       0.0732          0.1110      0.102         0.402
## density                  0.2602         -0.0013      0.145         0.836
## pH                      -0.4122         -0.0541     -0.156        -0.200
## sulphates               -0.0217         -0.0405      0.053        -0.052
## alcohol                 -0.1208          0.0896     -0.092        -0.470
## quality                 -0.1118         -0.1388     -0.043        -0.119
##                    chlorides freesulfurdioxide totalsulfurdioxide density
## fixedacidity          0.0095           -0.0559              0.073  0.2602
## volatileacidity       0.0461           -0.0715              0.111 -0.0013
## citricacid            0.1279            0.0914              0.102  0.1449
## residualsugar         0.0763            0.3183              0.402  0.8360
## chlorides             1.0000            0.1178              0.184  0.2501
## freesulfurdioxide     0.1178            1.0000              0.614  0.3188
## totalsulfurdioxide    0.1842            0.6139              1.000  0.5421
## density               0.2501            0.3188              0.542  1.0000
## pH                   -0.0825           -0.0062              0.010 -0.0959
## sulphates            -0.0010            0.0473              0.108  0.0566
## alcohol              -0.3629           -0.2662             -0.465 -0.8080
## quality              -0.2074            0.0081             -0.181 -0.3261
##                         pH sulphates alcohol quality
## fixedacidity       -0.4122    -0.022  -0.121 -0.1118
## volatileacidity    -0.0541    -0.040   0.090 -0.1388
## citricacid         -0.1562     0.053  -0.092 -0.0431
## residualsugar      -0.1995    -0.052  -0.470 -0.1189
## chlorides          -0.0825    -0.001  -0.363 -0.2074
## freesulfurdioxide  -0.0062     0.047  -0.266  0.0081
## totalsulfurdioxide  0.0103     0.108  -0.465 -0.1813
## density            -0.0959     0.057  -0.808 -0.3261
## pH                  1.0000     0.163   0.125  0.1063
## sulphates           0.1627     1.000  -0.019  0.0438
## alcohol             0.1246    -0.019   1.000  0.4409
## quality             0.1063     0.044   0.441  1.0000

Pelos gráficos acima, percebe-se:

  • Alta correlação positiva entre a densidade e a concentração residual de açúcar
  • Alta correlação positiva entre Total de SO2 e a taxa de SO2 livre
  • Alta correlação negativa entre o volume de alcool e a densidade
  • Correlação entre a densidade e o Total de SO2
  • Correlação negativa entre o álcool e a concentração residual de açúcar
  • Correlação entre a qualidade e o álcool



Verificando a correlação

Gráfico de dispersão do vinho branco entre a densidade e o açucar residual

Pelo gráfico, pode-se notar uma tendência linear entre as duas variáveis pelo formato do gráfico. Neste, pode-se perceber que, normalmente, quanto maior a densidade, maior a quantidade de açucar residual

Aqui traçou-se um gráfico para a quantidade residual de açúcar x qualidade para os vinhos brancos já sem os outliers. Percebe-se que os vinhos brancos de maior qualidade possuem uma concentração de açúcar menor que 20 g/L

Aplicando componentes principais

## [1] "Variância acumulada para cada componente "
##        eigenvalue variance.percent cumulative.variance.percent
## Dim.1  3.38909993       28.2424994                    28.24250
## Dim.2  1.58636636       13.2197197                    41.46222
## Dim.3  1.26219318       10.5182765                    51.98050
## Dim.4  1.12079756        9.3399797                    61.32048
## Dim.5  1.00233483        8.3527902                    69.67327
## Dim.6  0.95095122        7.9245935                    77.59786
## Dim.7  0.74903989        6.2419991                    83.83986
## Dim.8  0.73434715        6.1195596                    89.95942
## Dim.9  0.57112284        4.7593570                    94.71877
## Dim.10 0.34436192        2.8696826                    97.58846
## Dim.11 0.27531840        2.2943200                    99.88278
## Dim.12 0.01406673        0.1172227                   100.00000
## [1] "Percentual que cada componente contribui para explicar a variância "

Analisando-se o PCA do modelo completo sobre vinhos brancos, percebe-se:

  • Não há um componente que sozinho contribua com mais do que 29% da variância
  • Para conter mais do que 80% da variância há a necessidade de ao menos 7 componentes, o que implicaria em existir ao menos 7 componentes



Verificando os auto-vetores do primeiro de segundo componentes do PCA

Pelo gráfico de contribuição dos atributos em relação ao PCA, temos:

  • Percebe-se grupos com contribuições no mesmo quadrante e outros no oposto para cada um dos quadrantes
  • fixedacidity,citricacid,chlorides,volatileacidity contribuem no mesmo sentido. Havendo melhor alinhamento entre fixedacidity e citricacid.
  • residualsugar,density,totalsulfurdioxide,freesulfurdioxide,sulphates estão no mesmo quadrante. Havendo maior proximidade entre residualsugar e density, entre totalsulfurdioxide e freesulfurdioxide.
  • ph,quality estão no mesmo quadrante
  • alcohol está isolado no último quadrante, no entanto, está quase alinhado com residualsugar e density.
  • No primeiro componente há maior peso para os atributos densidade, açucar residual, SO2, SO2 livre e álcool
  • No segundo componente foi dado maior peso ao acidez fixa e pH

A partir dessas proximidades entre os auto vetores, e considerando as correlações, será feita uma segunda verificação do uso do PCA nas variáveis totalsulfurdioxide,freesulfurdioxide, density,residualsugar e alcohol

##       eigenvalue variance.percent cumulative.variance.percent
## Dim.1 3.05891171       61.1782342                    61.17823
## Dim.2 1.00870998       20.1741995                    81.35243
## Dim.3 0.54765165       10.9530331                    92.30547
## Dim.4 0.34022528        6.8045055                    99.10997
## Dim.5 0.04450138        0.8900277                   100.00000

Analisando a tabela acima, nota-se que os dois primeiros componentes já contribuem para mais de 80% da variancia da base. Mediante a constatação, criou-se dois novos atributos pca1 e pca2 correspondendo ao primeiro e segundo componentes do PCA. Por fim, os atributos originais foram excluídos do modelo por serem passíveis de substituição sem grandes prejuízos.

## [1] "Histograma do Primeiro Componente"

## [1] "Histograma do Segundo Componente"

Regressões

# Split em conjuntos de treinamento e teste
set.seed(333)
treinamento <- sample_frac(VinhosBrancosNum, 0.7)
teste <- setdiff(VinhosBrancosNum, treinamento)


# Dados sem a aplicação do PCA
treinamento %>%
  select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide,
         freesulfurdioxide, density, residualsugar, alcohol, quality) -> treinamento_semPCA

teste %>% 
  select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide,
         freesulfurdioxide, density, residualsugar, alcohol, quality) -> teste_semPCA


# Dados com a aplicação do PCA
treinamento %>%
  select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, quality) -> treinamento_comPCA

teste %>% 
  select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, quality) -> teste_comPCA
# Modelo de regressão linear simples

modelo0 <- lm(quality ~ . ,
              data=treinamento_comPCA)



modelo1 <- lm(quality ~ . ,
              data=treinamento_semPCA)



measures <- function(x) {
  L <- list(npar = length(coef(x)),
            dfres = df.residual(x),
            nobs = length(fitted(x)),
            RMSE = summary(x)$sigma,
            R2 = summary(x)$r.squared,
            R2adj = summary(x)$adj.r.squared,
            PRESS = press(x),
            logLik = logLik(x),
            AIC = AIC(x),
            BIC = BIC(x))
  unlist(L)
}

modl <- list(m1 = modelo0,m2=modelo1)
round(t(sapply(modl, measures)), 3)
##    npar dfres nobs  RMSE    R2 R2adj    PRESS    logLik      AIC      BIC
## m1    9  3245 3254 0.794 0.166 0.164 2059.332 -3863.631 7747.262 7808.139
## m2   12  3242 3254 0.741 0.275 0.272 1794.333 -3636.296 7298.593 7377.732
# Modelo de regressão linear com o modelo aplicado o PCA
print("Modelo com regressão linear aplicada sobre o modelo com atributos gerados pelo PCA")
## [1] "Modelo com regressão linear aplicada sobre o modelo com atributos gerados pelo PCA"
result <- testa.modelo(modelo=modelo0, dataset=teste_comPCA, valores_observados=teste_comPCA$quality, tit_grafico = "Linear com PCA")
## [1] "Sumário do modelo...."
## [1] "MSE para o modelo---> 0.794633943337489"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"

# Modelo com os dados completos sem transformação via PCA
print("Modelo de regressão linear aplicada sobre o modelo com todos os atributos")
## [1] "Modelo de regressão linear aplicada sobre o modelo com todos os atributos"
result <- testa.modelo(modelo=modelo1, dataset=teste_semPCA, valores_observados=teste_semPCA$quality, tit_grafico = "Linear Completo")
## [1] "Sumário do modelo...."
## [1] "MSE para o modelo---> 0.747299468844422"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"

##### UTILIZANDO FORWARD,BACKWARD OU BOTH 

VinhosBrancosStep <- treinamento_semPCA


modelo.base <- lm(quality ~ fixedacidity,
              data=VinhosBrancosStep)



modelo.completo <- lm(quality ~ . ,
              data=VinhosBrancosStep)


modelo.medio <- lm(quality ~ fixedacidity+volatileacidity+citricacid+chlorides+pH+sulphates,
              data=VinhosBrancosStep)
 

forward<-step(modelo.base,direction="forward")
## Start:  AIC=-952.82
## quality ~ fixedacidity
backward<-step(modelo.completo,direction="backward")
## Start:  AIC=-1937.86
## quality ~ fixedacidity + volatileacidity + citricacid + chlorides + 
##     pH + sulphates + totalsulfurdioxide + freesulfurdioxide + 
##     density + residualsugar + alcohol
## 
##                      Df Sum of Sq    RSS     AIC
## - chlorides           1     0.047 1780.7 -1939.8
## - citricacid          1     0.268 1780.9 -1939.4
## - totalsulfurdioxide  1     0.291 1780.9 -1939.3
## <none>                            1780.7 -1937.9
## - alcohol             1     7.480 1788.1 -1926.2
## - fixedacidity        1     7.515 1788.2 -1926.2
## - freesulfurdioxide   1     9.352 1790.0 -1922.8
## - sulphates           1    12.070 1792.7 -1917.9
## - pH                  1    19.357 1800.0 -1904.7
## - density             1    26.707 1807.4 -1891.4
## - residualsugar       1    40.868 1821.5 -1866.0
## - volatileacidity     1    66.611 1847.3 -1820.3
## 
## Step:  AIC=-1939.77
## quality ~ fixedacidity + volatileacidity + citricacid + pH + 
##     sulphates + totalsulfurdioxide + freesulfurdioxide + density + 
##     residualsugar + alcohol
## 
##                      Df Sum of Sq    RSS     AIC
## - citricacid          1     0.244 1780.9 -1941.3
## - totalsulfurdioxide  1     0.282 1781.0 -1941.3
## <none>                            1780.7 -1939.8
## - alcohol             1     7.450 1788.2 -1928.2
## - fixedacidity        1     8.073 1788.8 -1927.0
## - freesulfurdioxide   1     9.305 1790.0 -1924.8
## - sulphates           1    12.251 1793.0 -1919.5
## - pH                  1    20.328 1801.0 -1904.8
## - density             1    28.081 1808.8 -1890.9
## - residualsugar       1    43.647 1824.3 -1863.0
## - volatileacidity     1    67.510 1848.2 -1820.7
## 
## Step:  AIC=-1941.33
## quality ~ fixedacidity + volatileacidity + pH + sulphates + totalsulfurdioxide + 
##     freesulfurdioxide + density + residualsugar + alcohol
## 
##                      Df Sum of Sq    RSS     AIC
## - totalsulfurdioxide  1     0.289 1781.2 -1942.8
## <none>                            1780.9 -1941.3
## - alcohol             1     7.698 1788.6 -1929.3
## - fixedacidity        1     8.407 1789.3 -1928.0
## - freesulfurdioxide   1     9.669 1790.6 -1925.7
## - sulphates           1    12.384 1793.3 -1920.8
## - pH                  1    20.088 1801.0 -1906.8
## - density             1    27.840 1808.8 -1892.8
## - residualsugar       1    43.403 1824.3 -1865.0
## - volatileacidity     1    68.509 1849.5 -1820.5
## 
## Step:  AIC=-1942.8
## quality ~ fixedacidity + volatileacidity + pH + sulphates + freesulfurdioxide + 
##     density + residualsugar + alcohol
## 
##                     Df Sum of Sq    RSS     AIC
## <none>                           1781.2 -1942.8
## - alcohol            1     7.427 1788.7 -1931.3
## - fixedacidity       1     8.871 1790.1 -1928.6
## - freesulfurdioxide  1    12.063 1793.3 -1922.8
## - sulphates          1    12.339 1793.6 -1922.3
## - pH                 1    20.520 1801.8 -1907.5
## - density            1    32.094 1813.3 -1886.7
## - residualsugar      1    47.688 1828.9 -1858.8
## - volatileacidity    1    74.740 1856.0 -1811.0
stepwise<-step(modelo.medio,direction="both")
## Start:  AIC=-1169.81
## quality ~ fixedacidity + volatileacidity + citricacid + chlorides + 
##     pH + sulphates
## 
##                   Df Sum of Sq    RSS     AIC
## - citricacid       1     1.174 2262.8 -1170.1
## - sulphates        1     1.302 2262.9 -1169.9
## <none>                         2261.6 -1169.8
## - pH               1     3.122 2264.7 -1167.3
## - fixedacidity     1    20.597 2282.2 -1142.3
## - volatileacidity  1    45.937 2307.6 -1106.4
## - chlorides        1    96.729 2358.3 -1035.5
## 
## Step:  AIC=-1170.12
## quality ~ fixedacidity + volatileacidity + chlorides + pH + sulphates
## 
##                   Df Sum of Sq    RSS     AIC
## <none>                         2262.8 -1170.1
## - sulphates        1     1.479 2264.3 -1170.0
## + citricacid       1     1.174 2261.6 -1169.8
## - pH               1     2.940 2265.7 -1167.9
## - fixedacidity     1    19.423 2282.2 -1144.3
## - volatileacidity  1    47.547 2310.3 -1104.5
## - chlorides        1    95.651 2358.4 -1037.4
print("*** Análise dos indicadores para modelos de regressão linear obtidos pelos métodos forward,backward e both ****")
## [1] "*** Análise dos indicadores para modelos de regressão linear obtidos pelos métodos forward,backward e both ****"
modl <- list(m1 = forward,m2=backward,m3=stepwise)
round(t(sapply(modl, measures)), 3)
##    npar dfres nobs  RMSE    R2 R2adj    PRESS    logLik      AIC      BIC
## m1    2  3252 3254 0.864 0.012 0.012 2428.240 -4138.817 8283.634 8301.897
## m2    9  3245 3254 0.741 0.275 0.273 1792.086 -3636.826 7293.653 7354.529
## m3    6  3248 3254 0.835 0.079 0.077 2272.160 -4026.164 8066.327 8108.941
##### TESTE DE PREDIÇÃO DOS MODELOS #######
print("Modelo de regressão linear utilizando a estratégia forward nos vinhos brancos com todos os atributos")
## [1] "Modelo de regressão linear utilizando a estratégia forward nos vinhos brancos com todos os atributos"
result<-testa.modelo(modelo=forward, dataset=teste_semPCA, valores_observados=teste_semPCA$quality, tit_grafico="Linear com forward")
## [1] "Sumário do modelo...."
## [1] "MSE para o modelo---> 0.864954247314014"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"

print("Modelo de regressão linear utilizando a estratégia backward nos vinhos brancos com todos os atributos")
## [1] "Modelo de regressão linear utilizando a estratégia backward nos vinhos brancos com todos os atributos"
result<-testa.modelo(modelo=backward, dataset=teste_semPCA, valores_observados=teste_semPCA$quality, tit_grafico = "Linear com backward")
## [1] "Sumário do modelo...."
## [1] "MSE para o modelo---> 0.747013073135287"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"

print("Modelo de regressão linear utilizando a estratégia both nos vinhos brancos com todos os atributos")
## [1] "Modelo de regressão linear utilizando a estratégia both nos vinhos brancos com todos os atributos"
result<-testa.modelo(modelo=stepwise, dataset=teste_semPCA, valores_observados=teste_semPCA$quality, tit_grafico = "Linear com both")
## [1] "Sumário do modelo...."
## [1] "MSE para o modelo---> 0.839878291284835"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"

##### Testa contra os piores modelos 

VinhosBrancosModelosRuins <- VinhosBrancosNum

#Utiliza como 
VinhosBrancosModelosRuins$qualidade.media <- mean(VinhosBrancosModelosRuins$quality)

valores_preditos <- VinhosBrancosModelosRuins$qualidade.media
print("Modelo Ruim -  retorna sempre a média ")
## [1] "Modelo Ruim -  retorna sempre a média "
result<-testa.modelo(modelo=NULL,valores_observados=VinhosBrancosModelosRuins$quality,
             valores_preditos=valores_preditos,tit_grafico = "Modelo Ruim - Sempre a média")
## [1] "MSE para o modelo---> 0.868162825258606"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
VinhosBrancosModelosRuins$qualidade.max <- max(VinhosBrancosModelosRuins$quality)
valores_preditos <- VinhosBrancosModelosRuins$qualidade.max

print("Modelo Ruim -  retorna sempre o máximo ")
## [1] "Modelo Ruim -  retorna sempre o máximo "
result<-testa.modelo(modelo=NULL,valores_observados=VinhosBrancosModelosRuins$quality,
             valores_preditos=valores_preditos,tit_grafico = "Modelo Ruim - sempre o máximo")
## [1] "MSE para o modelo---> 3.20978361316982"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"

library(rpart)


print("Modelo de Árvore de regressão com aplicação de PCA - atributos retirados")
## [1] "Modelo de Árvore de regressão com aplicação de PCA - atributos retirados"
result<-testa.modelo(modelo=modelo_Valor_tree0, dataset=teste_comPCA, valores_observados=teste_comPCA$quality, tit_grafico = "Árvore de Regressão com PCA", sumario=FALSE)
## [1] "Sumário do modelo...."
## List of 14
##  $ frame              :'data.frame': 341 obs. of  8 variables:
##   ..$ var       : Factor w/ 9 levels "<leaf>","chlorides",..: 5 9 2 9 7 8 6 5 7 1 ...
##   ..$ n         : int [1:341] 3254 2197 1412 1073 560 435 425 157 13 4 ...
##   ..$ wt        : num [1:341] 3254 2197 1412 1073 560 ...
##   ..$ dev       : num [1:341] 2456 1369 759 502 218 ...
##   ..$ yval      : num [1:341] 5.91 5.74 5.56 5.46 5.33 ...
##   ..$ complexity: num [1:341] 0.08662 0.04776 0.02123 0.00729 0.0026 ...
##   ..$ ncompete  : int [1:341] 4 4 4 4 4 4 4 4 4 0 ...
##   ..$ nsurrogate: int [1:341] 5 5 5 5 2 0 5 2 3 0 ...
##  $ where              : Named int [1:3254] 269 88 205 311 36 206 110 14 281 328 ...
##   ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
##  $ call               : language rpart(formula = quality ~ ., data = treinamento_comPCA, cp = 0.001,      minsplit = 5, maxdepth = 10)
##  $ terms              :Classes 'terms', 'formula'  language quality ~ fixedacidity + volatileacidity + citricacid + chlorides +      pH + sulphates + pca1 + pca2
##   .. ..- attr(*, "variables")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides,      pH, sulphates, pca1, pca2)
##   .. ..- attr(*, "factors")= int [1:9, 1:8] 0 1 0 0 0 0 0 0 0 0 ...
##   .. .. ..- attr(*, "dimnames")=List of 2
##   .. .. .. ..$ : chr [1:9] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
##   .. .. .. ..$ : chr [1:8] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
##   .. ..- attr(*, "term.labels")= chr [1:8] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
##   .. ..- attr(*, "order")= int [1:8] 1 1 1 1 1 1 1 1
##   .. ..- attr(*, "intercept")= int 1
##   .. ..- attr(*, "response")= int 1
##   .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv> 
##   .. ..- attr(*, "predvars")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides,      pH, sulphates, pca1, pca2)
##   .. ..- attr(*, "dataClasses")= Named chr [1:9] "numeric" "numeric" "numeric" "numeric" ...
##   .. .. ..- attr(*, "names")= chr [1:9] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
##  $ cptable            : num [1:128, 1:5] 0.0866 0.0558 0.0478 0.0212 0.0118 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:128] "1" "2" "3" "4" ...
##   .. ..$ : chr [1:5] "CP" "nsplit" "rel error" "xerror" ...
##  $ method             : chr "anova"
##  $ parms              : NULL
##  $ control            :List of 9
##   ..$ minsplit      : num 5
##   ..$ minbucket     : num 2
##   ..$ cp            : num 0.001
##   ..$ maxcompete    : int 4
##   ..$ maxsurrogate  : int 5
##   ..$ usesurrogate  : int 2
##   ..$ surrogatestyle: int 0
##   ..$ maxdepth      : num 10
##   ..$ xval          : int 10
##  $ functions          :List of 2
##   ..$ summary:function (yval, dev, wt, ylevel, digits)  
##   ..$ text   :function (yval, dev, wt, ylevel, digits, n, use.n)  
##  $ numresp            : int 1
##  $ splits             : num [1:1304, 1:5] 3254 3254 3254 3254 3254 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:1304] "pca1" "chlorides" "pca2" "citricacid" ...
##   .. ..$ : chr [1:5] "count" "ncat" "improve" "index" ...
##  $ variable.importance: Named num [1:8] 475 377 275 254 200 ...
##   ..- attr(*, "names")= chr [1:8] "pca1" "pca2" "chlorides" "volatileacidity" ...
##  $ y                  : Named int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
##   ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
##  $ ordered            : Named logi [1:8] FALSE FALSE FALSE FALSE FALSE FALSE ...
##   ..- attr(*, "names")= chr [1:8] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
##  - attr(*, "xlevels")= Named list()
##  - attr(*, "class")= chr "rpart"
## [1] "MSE para o modelo---> 0.860193041488428"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"

library(rpart)


print("Modelo de Árvore de regressão com todos os atributos - sem aplicação de PCA")
## [1] "Modelo de Árvore de regressão com todos os atributos - sem aplicação de PCA"
result<-testa.modelo(modelo=modelo_Valor_tree1, dataset=teste_semPCA, valores_observados=teste_semPCA$quality, tit_grafico = "Árvore de Regressão completa", sumario=FALSE)
## [1] "Sumário do modelo...."
## List of 14
##  $ frame              :'data.frame': 311 obs. of  8 variables:
##   ..$ var       : Factor w/ 12 levels "<leaf>","alcohol",..: 2 12 2 7 11 1 1 4 10 6 ...
##   ..$ n         : int [1:311] 3254 2065 1064 837 59 37 22 778 182 121 ...
##   ..$ wt        : num [1:311] 3254 2065 1064 837 59 ...
##   ..$ dev       : num [1:311] 2455.6 1189.1 463.4 290.2 22.2 ...
##   ..$ yval      : num [1:311] 5.91 5.64 5.39 5.32 4.88 ...
##   ..$ complexity: num [1:311] 0.17476 0.05444 0.00801 0.00498 0.00171 ...
##   ..$ ncompete  : int [1:311] 4 4 4 4 4 0 0 4 4 4 ...
##   ..$ nsurrogate: int [1:311] 5 5 5 2 5 0 0 5 5 0 ...
##  $ where              : Named int [1:3254] 236 129 54 223 60 114 81 6 305 284 ...
##   ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
##  $ call               : language rpart(formula = quality ~ ., data = treinamento_semPCA, cp = 0.001,      minsplit = 5, maxdepth = 10)
##  $ terms              :Classes 'terms', 'formula'  language quality ~ fixedacidity + volatileacidity + citricacid + chlorides +      pH + sulphates + totalsulfurdioxide + fr| __truncated__ ...
##   .. ..- attr(*, "variables")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides,      pH, sulphates, totalsulfurdioxide, frees| __truncated__ ...
##   .. ..- attr(*, "factors")= int [1:12, 1:11] 0 1 0 0 0 0 0 0 0 0 ...
##   .. .. ..- attr(*, "dimnames")=List of 2
##   .. .. .. ..$ : chr [1:12] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
##   .. .. .. ..$ : chr [1:11] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
##   .. ..- attr(*, "term.labels")= chr [1:11] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
##   .. ..- attr(*, "order")= int [1:11] 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..- attr(*, "intercept")= int 1
##   .. ..- attr(*, "response")= int 1
##   .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv> 
##   .. ..- attr(*, "predvars")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides,      pH, sulphates, totalsulfurdioxide, frees| __truncated__ ...
##   .. ..- attr(*, "dataClasses")= Named chr [1:12] "numeric" "numeric" "numeric" "numeric" ...
##   .. .. ..- attr(*, "names")= chr [1:12] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
##  $ cptable            : num [1:110, 1:5] 0.1748 0.0544 0.0281 0.0165 0.0112 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:110] "1" "2" "3" "4" ...
##   .. ..$ : chr [1:5] "CP" "nsplit" "rel error" "xerror" ...
##  $ method             : chr "anova"
##  $ parms              : NULL
##  $ control            :List of 9
##   ..$ minsplit      : num 5
##   ..$ minbucket     : num 2
##   ..$ cp            : num 0.001
##   ..$ maxcompete    : int 4
##   ..$ maxsurrogate  : int 5
##   ..$ usesurrogate  : int 2
##   ..$ surrogatestyle: int 0
##   ..$ maxdepth      : num 10
##   ..$ xval          : int 10
##  $ functions          :List of 2
##   ..$ summary:function (yval, dev, wt, ylevel, digits)  
##   ..$ text   :function (yval, dev, wt, ylevel, digits, n, use.n)  
##  $ numresp            : int 1
##  $ splits             : num [1:1314, 1:5] 3254 3254 3254 3254 3254 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:1314] "alcohol" "density" "chlorides" "totalsulfurdioxide" ...
##   .. ..$ : chr [1:5] "count" "ncat" "improve" "index" ...
##  $ variable.importance: Named num [1:11] 629 503 273 269 259 ...
##   ..- attr(*, "names")= chr [1:11] "alcohol" "density" "totalsulfurdioxide" "chlorides" ...
##  $ y                  : Named int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
##   ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
##  $ ordered            : Named logi [1:11] FALSE FALSE FALSE FALSE FALSE FALSE ...
##   ..- attr(*, "names")= chr [1:11] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
##  - attr(*, "xlevels")= Named list()
##  - attr(*, "class")= chr "rpart"
## [1] "MSE para o modelo---> 0.830208896967626"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"

# Regressão Logística

treinamento_comPCA %>% 
  mutate(quality_rel = quality/10) -> treinamento_comPCA_rel

treinamento_comPCA$quality <- NULL

treinamento_semPCA %>% 
  mutate(quality_rel = quality/10) -> treinamento_semPCA_rel

treinamento_semPCA$quality <- NULL

teste_comPCA %>% 
  mutate(quality_rel = quality/10) -> teste_comPCA_rel

teste_comPCA$quality <- NULL

teste_semPCA %>% 
  mutate(quality_rel = quality/10) -> teste_semPCA_rel

teste_semPCA$quality <- NULL


# Regressão Logística com a aplicação do PCA

modelo_logistica0 <- glm(quality_rel ~ . , 
                        family = binomial(link = 'logit'),
                        data = treinamento_comPCA_rel)


print("Modelo de Regressão Logística com aplicação de PCA - atributos retirados")
## [1] "Modelo de Regressão Logística com aplicação de PCA - atributos retirados"
result<-testa.modelo(modelo=modelo_logistica0, dataset=teste_comPCA_rel, valores_observados=teste_comPCA_rel$quality_rel, tit_grafico = "Regressão Logística com PCA", sumario=FALSE)
## [1] "Sumário do modelo...."
## List of 30
##  $ coefficients     : Named num [1:10] -2.190683 0.000932 0.03144 -0.001623 0.0073 ...
##   ..- attr(*, "names")= chr [1:10] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
##  $ residuals        : Named num [1:3254] 0.000116 -0.003817 0.007515 -0.016336 0.00977 ...
##   ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
##  $ fitted.values    : Named num [1:3254] 0.7 0.701 0.498 0.604 0.498 ...
##   ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
##  $ effects          : Named num [1:3254] -9.8346 -1.0663 1.5379 -0.0672 1.9127 ...
##   ..- attr(*, "names")= chr [1:3254] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
##  $ R                : num [1:10, 1:10] -27.6 0 0 0 0 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:10] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
##   .. ..$ : chr [1:10] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
##  $ rank             : int 10
##  $ qr               :List of 5
##   ..$ qr   : num [1:3254, 1:10] -27.5993 0.0166 0.0181 0.0177 0.0181 ...
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ : chr [1:3254] "1" "2" "3" "4" ...
##   .. .. ..$ : chr [1:10] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
##   ..$ rank : int 10
##   ..$ qraux: num [1:10] 1.02 1.02 1.02 1.02 1.01 ...
##   ..$ pivot: int [1:10] 1 2 3 4 5 6 7 8 9 10
##   ..$ tol  : num 1e-11
##   ..- attr(*, "class")= chr "qr"
##  $ family           :List of 12
##   ..$ family    : chr "binomial"
##   ..$ link      : chr "logit"
##   ..$ linkfun   :function (mu)  
##   ..$ linkinv   :function (eta)  
##   ..$ variance  :function (mu)  
##   ..$ dev.resids:function (y, mu, wt)  
##   ..$ aic       :function (y, n, mu, wt, dev)  
##   ..$ mu.eta    :function (eta)  
##   ..$ initialize:  expression({  if (NCOL(y) == 1) {  if (is.factor(y))  y <- y != levels(y)[1L]  n <- rep.int(1, nobs)  y[weights =| __truncated__
##   ..$ validmu   :function (mu)  
##   ..$ valideta  :function (eta)  
##   ..$ simulate  :function (object, nsim)  
##   ..- attr(*, "class")= chr "family"
##  $ linear.predictors: Named num [1:3254] 0.84718 0.85111 -0.00751 0.42177 -0.00977 ...
##   ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
##  $ deviance         : num 0.436
##  $ aic              : num 3402
##  $ null.deviance    : num 104
##  $ iter             : int 4
##  $ weights          : Named num [1:3254] 0.21 0.21 0.25 0.239 0.25 ...
##   ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
##  $ prior.weights    : Named num [1:3254] 1 1 1 1 1 1 1 1 1 1 ...
##   ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
##  $ df.residual      : int 3244
##  $ df.null          : int 3253
##  $ y                : Named num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
##   ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
##  $ converged        : logi TRUE
##  $ boundary         : logi FALSE
##  $ model            :'data.frame':   3254 obs. of  10 variables:
##   ..$ quality_rel    : num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
##   ..$ fixedacidity   : num [1:3254] 6.8 6 8.2 8.4 6.2 9.7 6.1 7.1 6.4 6.1 ...
##   ..$ volatileacidity: num [1:3254] 0.17 0.24 0.37 0.27 0.345 0.24 0.32 0.47 0.32 0.27 ...
##   ..$ citricacid     : num [1:3254] 0.35 0.27 0.27 0.3 0.27 0.49 0.25 0.24 0.25 0.32 ...
##   ..$ chlorides      : num [1:3254] 0.04 0.048 0.028 0.037 0.056 0.032 0.034 0.044 0.055 0.034 ...
##   ..$ pH             : num [1:3254] 2.91 3.64 2.97 2.89 3.31 2.85 3.47 3.21 3.27 3.36 ...
##   ..$ sulphates      : num [1:3254] 0.57 0.54 0.48 0.3 0.56 0.54 0.5 0.56 0.5 0.4 ...
##   ..$ pca1           : num [1:3254] -2.498 0.162 -2.086 -1.412 1.02 ...
##   ..$ pca2           : num [1:3254] 0.232 0.728 -1.559 0.756 0.375 ...
##   ..$ quality        : int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
##   ..- attr(*, "terms")=Classes 'terms', 'formula'  language quality_rel ~ fixedacidity + volatileacidity + citricacid + chlorides +      pH + sulphates + pca1 + pca2 + quality
##   .. .. ..- attr(*, "variables")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides,      pH, sulphates, pca1, pca2, quality)
##   .. .. ..- attr(*, "factors")= int [1:10, 1:9] 0 1 0 0 0 0 0 0 0 0 ...
##   .. .. .. ..- attr(*, "dimnames")=List of 2
##   .. .. .. .. ..$ : chr [1:10] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
##   .. .. .. .. ..$ : chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
##   .. .. ..- attr(*, "term.labels")= chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
##   .. .. ..- attr(*, "order")= int [1:9] 1 1 1 1 1 1 1 1 1
##   .. .. ..- attr(*, "intercept")= int 1
##   .. .. ..- attr(*, "response")= int 1
##   .. .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv> 
##   .. .. ..- attr(*, "predvars")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides,      pH, sulphates, pca1, pca2, quality)
##   .. .. ..- attr(*, "dataClasses")= Named chr [1:10] "numeric" "numeric" "numeric" "numeric" ...
##   .. .. .. ..- attr(*, "names")= chr [1:10] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
##  $ call             : language glm(formula = quality_rel ~ ., family = binomial(link = "logit"),      data = treinamento_comPCA_rel)
##  $ formula          :Class 'formula'  language quality_rel ~ .
##   .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv> 
##  $ terms            :Classes 'terms', 'formula'  language quality_rel ~ fixedacidity + volatileacidity + citricacid + chlorides +      pH + sulphates + pca1 + pca2 + quality
##   .. ..- attr(*, "variables")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides,      pH, sulphates, pca1, pca2, quality)
##   .. ..- attr(*, "factors")= int [1:10, 1:9] 0 1 0 0 0 0 0 0 0 0 ...
##   .. .. ..- attr(*, "dimnames")=List of 2
##   .. .. .. ..$ : chr [1:10] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
##   .. .. .. ..$ : chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
##   .. ..- attr(*, "term.labels")= chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
##   .. ..- attr(*, "order")= int [1:9] 1 1 1 1 1 1 1 1 1
##   .. ..- attr(*, "intercept")= int 1
##   .. ..- attr(*, "response")= int 1
##   .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv> 
##   .. ..- attr(*, "predvars")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides,      pH, sulphates, pca1, pca2, quality)
##   .. ..- attr(*, "dataClasses")= Named chr [1:10] "numeric" "numeric" "numeric" "numeric" ...
##   .. .. ..- attr(*, "names")= chr [1:10] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
##  $ data             :'data.frame':   3254 obs. of  10 variables:
##   ..$ fixedacidity   : num [1:3254] 6.8 6 8.2 8.4 6.2 9.7 6.1 7.1 6.4 6.1 ...
##   ..$ volatileacidity: num [1:3254] 0.17 0.24 0.37 0.27 0.345 0.24 0.32 0.47 0.32 0.27 ...
##   ..$ citricacid     : num [1:3254] 0.35 0.27 0.27 0.3 0.27 0.49 0.25 0.24 0.25 0.32 ...
##   ..$ chlorides      : num [1:3254] 0.04 0.048 0.028 0.037 0.056 0.032 0.034 0.044 0.055 0.034 ...
##   ..$ pH             : num [1:3254] 2.91 3.64 2.97 2.89 3.31 2.85 3.47 3.21 3.27 3.36 ...
##   ..$ sulphates      : num [1:3254] 0.57 0.54 0.48 0.3 0.56 0.54 0.5 0.56 0.5 0.4 ...
##   ..$ pca1           : num [1:3254] -2.498 0.162 -2.086 -1.412 1.02 ...
##   ..$ pca2           : num [1:3254] 0.232 0.728 -1.559 0.756 0.375 ...
##   ..$ quality        : int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
##   ..$ quality_rel    : num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
##  $ offset           : NULL
##  $ control          :List of 3
##   ..$ epsilon: num 1e-08
##   ..$ maxit  : num 25
##   ..$ trace  : logi FALSE
##  $ method           : chr "glm.fit"
##  $ contrasts        : NULL
##  $ xlevels          : Named list()
##  - attr(*, "class")= chr [1:2] "glm" "lm"
## [1] "MSE para o modelo---> 0.365047384034817"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"

# Regressão Logística sem a aplicação de PCA

modelo_logistica1 <- glm(quality_rel ~ . , 
                        family = binomial(link = 'logit'),
                        data = treinamento_semPCA_rel)


print("Modelo de Regressão Logística com todos os atributos - sem aplicação de PCA")
## [1] "Modelo de Regressão Logística com todos os atributos - sem aplicação de PCA"
result<-testa.modelo(modelo=modelo_logistica1, dataset=teste_semPCA_rel, valores_observados=teste_semPCA_rel$quality_rel, tit_grafico = "Regressão Logística completa", sumario=FALSE)
## [1] "Sumário do modelo...."
## List of 30
##  $ coefficients     : Named num [1:13] -2.421499 0.000672 0.033491 -0.001266 -0.006122 ...
##   ..- attr(*, "names")= chr [1:13] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
##  $ residuals        : Named num [1:3254] 0.000287 -0.005205 0.00676 -0.016403 0.010866 ...
##   ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
##  $ fitted.values    : Named num [1:3254] 0.7 0.701 0.498 0.604 0.497 ...
##   ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
##  $ effects          : Named num [1:3254] -9.8346 -1.0664 1.5375 -0.0671 1.9128 ...
##   ..- attr(*, "names")= chr [1:3254] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
##  $ R                : num [1:13, 1:13] -27.6 0 0 0 0 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:13] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
##   .. ..$ : chr [1:13] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
##  $ rank             : int 13
##  $ qr               :List of 5
##   ..$ qr   : num [1:3254, 1:13] -27.5993 0.0166 0.0181 0.0177 0.0181 ...
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ : chr [1:3254] "1" "2" "3" "4" ...
##   .. .. ..$ : chr [1:13] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
##   ..$ rank : int 13
##   ..$ qraux: num [1:13] 1.02 1.02 1.02 1.02 1.01 ...
##   ..$ pivot: int [1:13] 1 2 3 4 5 6 7 8 9 10 ...
##   ..$ tol  : num 1e-11
##   ..- attr(*, "class")= chr "qr"
##  $ family           :List of 12
##   ..$ family    : chr "binomial"
##   ..$ link      : chr "logit"
##   ..$ linkfun   :function (mu)  
##   ..$ linkinv   :function (eta)  
##   ..$ variance  :function (mu)  
##   ..$ dev.resids:function (y, mu, wt)  
##   ..$ aic       :function (y, n, mu, wt, dev)  
##   ..$ mu.eta    :function (eta)  
##   ..$ initialize:  expression({  if (NCOL(y) == 1) {  if (is.factor(y))  y <- y != levels(y)[1L]  n <- rep.int(1, nobs)  y[weights =| __truncated__
##   ..$ validmu   :function (mu)  
##   ..$ valideta  :function (eta)  
##   ..$ simulate  :function (object, nsim)  
##   ..- attr(*, "class")= chr "family"
##  $ linear.predictors: Named num [1:3254] 0.84701 0.8525 -0.00676 0.42184 -0.01087 ...
##   ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
##  $ deviance         : num 0.435
##  $ aic              : num 3409
##  $ null.deviance    : num 104
##  $ iter             : int 4
##  $ weights          : Named num [1:3254] 0.21 0.21 0.25 0.239 0.25 ...
##   ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
##  $ prior.weights    : Named num [1:3254] 1 1 1 1 1 1 1 1 1 1 ...
##   ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
##  $ df.residual      : int 3241
##  $ df.null          : int 3253
##  $ y                : Named num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
##   ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
##  $ converged        : logi TRUE
##  $ boundary         : logi FALSE
##  $ model            :'data.frame':   3254 obs. of  13 variables:
##   ..$ quality_rel       : num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
##   ..$ fixedacidity      : num [1:3254] 6.8 6 8.2 8.4 6.2 9.7 6.1 7.1 6.4 6.1 ...
##   ..$ volatileacidity   : num [1:3254] 0.17 0.24 0.37 0.27 0.345 0.24 0.32 0.47 0.32 0.27 ...
##   ..$ citricacid        : num [1:3254] 0.35 0.27 0.27 0.3 0.27 0.49 0.25 0.24 0.25 0.32 ...
##   ..$ chlorides         : num [1:3254] 0.04 0.048 0.028 0.037 0.056 0.032 0.034 0.044 0.055 0.034 ...
##   ..$ pH                : num [1:3254] 2.91 3.64 2.97 2.89 3.31 2.85 3.47 3.21 3.27 3.36 ...
##   ..$ sulphates         : num [1:3254] 0.57 0.54 0.48 0.3 0.56 0.54 0.5 0.56 0.5 0.4 ...
##   ..$ totalsulfurdioxide: num [1:3254] 84 170 59 129 187 18 136 77 138 110 ...
##   ..$ freesulfurdioxide : num [1:3254] 29 40 10 36 38 3 37 11 28 24 ...
##   ..$ density           : num [1:3254] 0.99 0.994 0.992 0.991 0.995 ...
##   ..$ residualsugar     : num [1:3254] 1.8 1.9 1.7 2.2 10.1 4.9 1.7 6 5 1.1 ...
##   ..$ alcohol           : num [1:3254] 12 10 10.4 11.5 10.6 ...
##   ..$ quality           : int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
##   ..- attr(*, "terms")=Classes 'terms', 'formula'  language quality_rel ~ fixedacidity + volatileacidity + citricacid + chlorides +      pH + sulphates + totalsulfurdioxide | __truncated__ ...
##   .. .. ..- attr(*, "variables")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides,      pH, sulphates, totalsulfurdioxide, f| __truncated__ ...
##   .. .. ..- attr(*, "factors")= int [1:13, 1:12] 0 1 0 0 0 0 0 0 0 0 ...
##   .. .. .. ..- attr(*, "dimnames")=List of 2
##   .. .. .. .. ..$ : chr [1:13] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
##   .. .. .. .. ..$ : chr [1:12] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
##   .. .. ..- attr(*, "term.labels")= chr [1:12] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
##   .. .. ..- attr(*, "order")= int [1:12] 1 1 1 1 1 1 1 1 1 1 ...
##   .. .. ..- attr(*, "intercept")= int 1
##   .. .. ..- attr(*, "response")= int 1
##   .. .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv> 
##   .. .. ..- attr(*, "predvars")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides,      pH, sulphates, totalsulfurdioxide, f| __truncated__ ...
##   .. .. ..- attr(*, "dataClasses")= Named chr [1:13] "numeric" "numeric" "numeric" "numeric" ...
##   .. .. .. ..- attr(*, "names")= chr [1:13] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
##  $ call             : language glm(formula = quality_rel ~ ., family = binomial(link = "logit"),      data = treinamento_semPCA_rel)
##  $ formula          :Class 'formula'  language quality_rel ~ .
##   .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv> 
##  $ terms            :Classes 'terms', 'formula'  language quality_rel ~ fixedacidity + volatileacidity + citricacid + chlorides +      pH + sulphates + totalsulfurdioxide | __truncated__ ...
##   .. ..- attr(*, "variables")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides,      pH, sulphates, totalsulfurdioxide, f| __truncated__ ...
##   .. ..- attr(*, "factors")= int [1:13, 1:12] 0 1 0 0 0 0 0 0 0 0 ...
##   .. .. ..- attr(*, "dimnames")=List of 2
##   .. .. .. ..$ : chr [1:13] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
##   .. .. .. ..$ : chr [1:12] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
##   .. ..- attr(*, "term.labels")= chr [1:12] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
##   .. ..- attr(*, "order")= int [1:12] 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..- attr(*, "intercept")= int 1
##   .. ..- attr(*, "response")= int 1
##   .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv> 
##   .. ..- attr(*, "predvars")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides,      pH, sulphates, totalsulfurdioxide, f| __truncated__ ...
##   .. ..- attr(*, "dataClasses")= Named chr [1:13] "numeric" "numeric" "numeric" "numeric" ...
##   .. .. ..- attr(*, "names")= chr [1:13] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
##  $ data             :'data.frame':   3254 obs. of  13 variables:
##   ..$ fixedacidity      : num [1:3254] 6.8 6 8.2 8.4 6.2 9.7 6.1 7.1 6.4 6.1 ...
##   ..$ volatileacidity   : num [1:3254] 0.17 0.24 0.37 0.27 0.345 0.24 0.32 0.47 0.32 0.27 ...
##   ..$ citricacid        : num [1:3254] 0.35 0.27 0.27 0.3 0.27 0.49 0.25 0.24 0.25 0.32 ...
##   ..$ chlorides         : num [1:3254] 0.04 0.048 0.028 0.037 0.056 0.032 0.034 0.044 0.055 0.034 ...
##   ..$ pH                : num [1:3254] 2.91 3.64 2.97 2.89 3.31 2.85 3.47 3.21 3.27 3.36 ...
##   ..$ sulphates         : num [1:3254] 0.57 0.54 0.48 0.3 0.56 0.54 0.5 0.56 0.5 0.4 ...
##   ..$ totalsulfurdioxide: num [1:3254] 84 170 59 129 187 18 136 77 138 110 ...
##   ..$ freesulfurdioxide : num [1:3254] 29 40 10 36 38 3 37 11 28 24 ...
##   ..$ density           : num [1:3254] 0.99 0.994 0.992 0.991 0.995 ...
##   ..$ residualsugar     : num [1:3254] 1.8 1.9 1.7 2.2 10.1 4.9 1.7 6 5 1.1 ...
##   ..$ alcohol           : num [1:3254] 12 10 10.4 11.5 10.6 ...
##   ..$ quality           : int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
##   ..$ quality_rel       : num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
##  $ offset           : NULL
##  $ control          :List of 3
##   ..$ epsilon: num 1e-08
##   ..$ maxit  : num 25
##   ..$ trace  : logi FALSE
##  $ method           : chr "glm.fit"
##  $ contrasts        : NULL
##  $ xlevels          : Named list()
##  - attr(*, "class")= chr [1:2] "glm" "lm"
## [1] "MSE para o modelo---> 0.365071067344587"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"

Algoritmo não supervisionado

treinamento %>%
  select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide,
         freesulfurdioxide, density, residualsugar, alcohol) -> NS_treinamento_semPCA

# Dados com a aplicação do PCA
treinamento %>%
  select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2) -> NS_treinamento_comPCA


kmeans_semPCA <- kmeans(NS_treinamento_semPCA, 7)

kmeans_comPCA <- kmeans(NS_treinamento_comPCA, 7)

print("Quantidade de amostras por qualidade")
## [1] "Quantidade de amostras por qualidade"
table(treinamento$quality)
## 
##    3    4    5    6    7    8    9 
##    8   85  947 1482  609  119    4
print("")
## [1] ""
print("Quantidade de amostras por cluster sem PCA")
## [1] "Quantidade de amostras por cluster sem PCA"
kmeans_semPCA$size
## [1] 494 771 455 257 649 259 369
print("")
## [1] ""
print("Quantidade de amostras por cluster com PCA")
## [1] "Quantidade de amostras por cluster com PCA"
kmeans_comPCA$size
## [1] 662 502 420 475 352 462 381
print("")
## [1] ""